home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Apple II Magazines (PO)
/
Nibble Volume 07, No. 05 (1986-05)(MicroSPARC)(Side A).zip
/
Nibble Volume 07, No. 05 (1986-05)(MicroSPARC)(Side A).po
/
LIBRARIAN.S
< prev
next >
Wrap
Text File
|
1996-12-24
|
29KB
|
955 lines
LST ON,NOA,G
;
REP 32
* *
* LIBRARIAN *
* by Ken Manly *
* *
* Copyright (C) 1986 *
* MicroSPARC, Inc. *
* 45 Winthrop Street *
* Concord, MA 01742 *
* *
REP 32
* EDASM.SYSTEM assembler *
REP 32
;
HIMEM EQU $73
IPTR EQU $EE
DATPTR EQU $FA
SCTPTR EQU $FC
PRTPTR EQU $FE
INPUT EQU $200
DEFSLT EQU $BE3C
DEFDRV EQU $BE3D
VPATH1 EQU $BE6C
GOSYSTEM EQU $BE70
BADCALL EQU $BE8B
CRACESS EQU $BEA3
CRFILID EQU $BEA4
CRAUXID EQU $BEA5
CRFKIND EQU $BEA7
SREFNUM EQU $BEC7
SUNITNUM EQU $BEC7
SBUFADR EQU $BEC8
SMARK EQU $BEC8
OSYSBUF EQU $BECE
OREFNUM EQU $BED0
RWREFNUM EQU $BED6
RWDATA EQU $BED7
RWCOUNT EQU $BED9
CREFNUM EQU $BEDE
MLI EQU $BF00
DEVCNT EQU $BF31
DEVLST EQU $BF32
MACHID EQU $BF98
PFIXPTR EQU $BF9A
KBD EQU $C000
KBSTRB EQU $C010
TABV EQU $FB5B
CLREOP EQU $FC42
HOME EQU $FC58
RDKEY EQU $FD0C
NXTCHAR EQU $FD75
CROUT EQU $FD8E
COUT EQU $FDED
BELL EQU $FF3A
SETV EQU $FF58 ;Known $60 to set V bit
;
;ProDOS MLI function call codes
;
RDBLK.C EQU $80
CREATE.C EQU $C0
ONLINE.C EQU $C5
OPEN.C EQU $C8
WRITE.C EQU $CB
CLOSE.C EQU $CC
SETMARK.C EQU $CE
GETMARK.C EQU $CF
SETEOF.C EQU $D0
GETEOF.C EQU $D1
;
MSB ON
ORG $1000
REP 32
JSR HOME
LDX #BANNER1-BANNER0
LDY #0 ;Print greeting
BNRLP LDA BANNER0,Y
BIT MACHID
BMI BNROUT ;On Apple II,
JSR UPCASE ; change lower case to upper
BNROUT JSR COUT
INY
DEX
BNE BNRLP
;
;Top level of LIBRARIAN
;
START CLC
LDA HIMEM+1 ;Use system buffer
STA IBUF ; for catalog sector
ADC #2
STA IBUFTOP ;Limit for scanning input buffer
SBC #13
STA DBUFTOP ;Limit for data buffer
LDA #<END+$100 ;Beginning of data buffer
STA DATPTR+1
LDA #0
STA DATPTR
LDY DEVCNT ;Number of disk drives
INY
STY IDEV ;Initialize drive selector
GETDSK JSR SRCEPRMPT ;Ask for disk
BCC GO
BCS WRITEOUT
TRYAGAIN JSR READERR
BCS WRITEOUT
GO LDY #<READMSG
LDX #>READMSG
LDA #10
JSR MESSAGE
JSR FINDDSK ;Identify disk
BCS TRYAGAIN
LDA #$80
STA FIRSTBLK ;Indicate start new catalog
LDY #<READMSG
LDX #>READMSG
LDA #10
JSR MESSAGE
BIT DISKID
BPL CTPS ;Bit 6 clear for Pascal
BVS CTPD ;Bit 7 set for ProDOS
BVC CTD3 ;Bit 7 clear for DOS 3.3
CTPS JSR PASCAT ;Do Pascal disk
BCS ERROR
BCC CHKSPACE
CTPD JSR PROCAT ;Do ProDOS disk
BCS ERROR
BCC CHKSPACE
CTD3 JSR DOSCAT ;Do DOS disk
BCS ERROR
CHKSPACE LDA DATPTR+1
CMP DBUFTOP
BCC GETDSK ;Still room for more
JSR BELL
WRITEOUT LDA DATPTR
BNE WROUT ;Any data to file?
LDA DATPTR+1
CMP #<END+$100
BEQ ENDITALL ;No
WROUT JSR DESTPRMPT
BCS ENDITALL
JSR OUTFILE ;Write file information
BCS WROUT1
JMP START ;Do it again
WROUT1 JSR WRITERR
JMP WROUT
ENDITALL LDY #<BYE
LDX #>BYE
LDA #14
JSR MESSAGE
LDA #$0D
STA INPUT
CLC
RTS
;
;Error handling
;
ERROR STA ERRCODE ;Save error code
LDA #0
STA CREFNUM
LDA #CLOSE.C ;Close all files
JSR GOSYSTEM
SEC ;Indicate error
LDA ERRCODE ;Get error code
BNE ERROR1 ;Error was real
CLC ;Error was a fake to
RTS ; escape
ERROR1 LDX #>RDERRMSG
LDY #<RDERRMSG
JSR PROMPT
JMP CHKSPACE ;Back into the program
REP 32
;
;Subroutine to find a disk
;
DEVLP LDY DEVCNT ;Number of disk drives
INY
STY IDEV
BIT KBD
BPL FINDDSK
SEC ;Abort on keystroke
LDA KBSTRB
LDA #8 ;Fake error
BCS DEVRTN
FINDDSK DEC IDEV
BPL NXTDEV
BMI DEVLP
NXTDEV LDY IDEV ;Pick a drive from
LDX DEVLST,Y ; device list
TXA
AND #$0F ;Look at device ID
BNE FINDDSK ;Not a Disk II
TXA
AND #$F0 ;Isolate device number
STA BRWUNIT ;Save in parm list
JSR RDIDBLK ;Try to identify disk
BCS FINDDSK ;Not there
DEVRTN RTS
;
;Subroutine to identify DOS 3.3, ProDOS,
; or PASCAL disks by characteristic bytes
;
RDIDBLK LDA IBUF
STA IPTR+1
LDA #0
STA IPTR
LDX #2 ;Read block 2
JSR READBLK
BCS RDIDRTN
LDY #2 ;Examine byte 2
LDA (IPTR),Y ;Get ID byte
LDY #7
IDLP CMP IDLIST,Y ;Look for it
BEQ GETIDBYTE ; in the list
DEY ; of acceptable
BPL IDLP ; bytes
LDA #6 ;Not found, load
SEC ; fake volume not found
BCS RDIDRTN ; error
GETIDBYTE LDA IDBYTES,Y ;Found, load and save the
STA DISKID ; corresponding code
CLC ;If C clear,
RDIDRTN RTS ; DISKID is valid
;
;Main subroutine to handle PASCAL directory
;
PASCAT LDA #2
STA CURBLK ;Start with block 2
PASCATLP LDX CURBLK
LDA #0
JSR READBLK
BCS PASCATRTN
JSR PASNAMES ;Transfer names to data buffer
BCS PASCATRTN
BVS PASCATRTN ;V set when finished
INC CURBLK ;Next block
LDA CURBLK
CMP #6
BCC PASCATLP
CLC
PASCATRTN RTS
;
;Main subroutine to handle ProDOS directory
;
PROCAT LDA #2
STA CURBLK ;Start with block 2
PROCATLP LDX CURBLK
LDA #0
JSR READBLK
BCS PROCATRTN
JSR PRONAMES ;Transfer names to data buffer
BCS PROCATRTN
BVS PROCATRTN
INC CURBLK ;Next block
LDA CURBLK
CMP #6
BCC PROCATLP
CLC
PROCATRTN RTS
;
;Main subroutine to handle DOS 3.3 catalog
;
DOSCAT JSR RDVTOC
BCS DOSCATRTN
DOSCATLP JSR NXTSECTOR
BEQ DOSCATFIN
BCS DOSCATRTN
JSR DOSNAMES
BCS DOSCATRTN
BVC DOSCATLP
DOSCATFIN CLC
DOSCATRTN RTS
;
;Subroutine to read sector chained to current one
;
NXTSECTOR LDA IBUF
STA BRWDATA+1
LDY #0
STY SCTPTR
INY
LDA (SCTPTR),Y ;Track number
BEQ NXTSRTN
TAX
INY
LDA (SCTPTR),Y ;Sector number
JSR RDTS
BCC NXTOK
JSR READERR
BCC NXTSECTOR
NXTOK STA SCTPTR+1
NXTSRTN RTS ;C set for err; Z set for end
;
;Subroutine to read VTOC
;
RDVTOC LDA IBUF
STA BRWDATA+1
LDX #17 ;Track 17
LDA #0 ;Sector 0
JSR RDTS ;Read it
STA SCTPTR+1
RTS
;
;Subroutine to read block indicated by A,X
;
READBLK STA BRWBLKNUM+1 ;Store desired block
STX BRWBLKNUM ; number in parm table
LDA IBUF ;Store address of
STA BRWDATA+1 ; input buffer in
LDA #0 ; parm table
STA BRWDATA
JSR MLI ;Go get it
DB RDBLK.C
DW BRW
BCS RDBLKRTN
BIT DISKID
BVS RDBLKRTN ;Not Pascal
INC BRWBLKNUM ;Put next block
INC BRWDATA+1 ;In upper half of
INC BRWDATA+1 ; input buffer
JSR MLI
DB RDBLK.C
DW BRW
RDBLKRTN RTS
;
;Subroutine to transfer Pascal filename
; to data buffer
;
PASNAMES BIT FIRSTBLK ;First entry?
BPL PACONT ;No
LSR FIRSTBLK
LDA #6
STA IPTR ;Points to
LDA IBUF
STA IPTR+1 ; volume name (length byte)
LDY #0
LDA (IPTR),Y
JSR GETVNAME
LDA #24 ;24 bytes to first file entry
JSR INCIPTR ;Raise input buffer pointer
PACONT LDY #0
LDA (IPTR),Y ;File type
STA FTYPE
LDA #2
JSR INCIPTR ;Raise input buffer pointer
LDA (IPTR),Y ;Filename length
STA FNMLNGTH
BNE PANXT
BIT SETV ;End of catalog
BVS PARTN ; V set to quit
PANXT LDX #5
JSR PUTOSNM ;Transfer system name
JSR PUTVNAME ;Transfer volume name
JSR TXFNAME ;Transfer file name
LDA FTYPE
ASL
ASL
CLC
ADC #4
TAX
LDA #4
JSR PUTTYPE ;Transfer file type
LDA #24 ;24 more bytes per file entry
JSR INCIPTR ;Raise input buffer pointer
BCC PACONT
LDA IBUF ;Reset pointer hi byte
STA IPTR+1 ; (leave low byte intact)
PARTN CLC
RTS
;
;Subroutine to transfer ProDOS filename
; to data buffer
;
PRONAMES BIT FIRSTBLK ;First entry?
BPL PRCONT ;No
LSR FIRSTBLK
LDA #4
STA IPTR ;Points to
LDA IBUF
STA IPTR+1 ; volume name (length byte)
LDY #0
LDA (IPTR),Y
AND #$0F ;Isolate volume name length
JSR GETVNAME
LDA #39
JSR INCIPTR ;Raise input buffer pointer
PRCONT LDY #0 ;Get length
LDA (IPTR),Y ; of filename
BEQ PRCHKEND ;Deleted file or end of cat
AND #$0F ;Isolate file name length
STA FNMLNGTH
LDY #$10
LDA (IPTR),Y ;File type
LDY #12
PRTYPLP DEY
BEQ PRSTTYP
CMP PRCODES,Y
BNE PRTYPLP
PRSTTYP STY FTYPE
LDX #11
JSR PUTOSNM ;Transfer system name
JSR PUTVNAME ;Transfer volume name
JSR TXFNAME ;Transfer file name
LDA FTYPE
ASL
CLC
ADC FTYPE
ADC #PRTYPES-TYPES+3
TAX
LDA #3
JSR PUTTYPE ;Transfer file type
JMP PRNXT
PRCHKEND INY
LDA (IPTR),Y ;Check first letter of filename
BNE PRNXT ;Deleted file; try next
BIT SETV ;File never was; end of catalog
BVS PRRTN
PRNXT LDA #39 ;39 bytes per file entry
JSR INCIPTR ;Raise input buffer pointer
BCC PRCONT
LDA IBUF ;Reset pointer hi byte
STA IPTR+1
LDA #4 ; and pointer low byte
STA IPTR
CLV ;Keep going
PRRTN CLC
RTS
;
;Subroutine to transfer DOS3.3 filename
; to data buffer
; Enter with hi byte of sector buffer in A
;
DOSNAMES STA IPTR+1 ;Pick right half of block
LDA #11 ;Points to track
STA IPTR ; byte ($FF if deleted)
BIT FIRSTBLK ;First entry?
BPL DSSCTLP ;No
LSR FIRSTBLK
LDY #<NAMEMSG
LDX #>NAMEMSG
LDA #10
JSR MESSAGE ;Ask for disk name
JSR CROUT
JSR NXTCHAR ;Accept name
STX VOLNAME
DSNMLP LDA INPUT-1,X
AND #$7F
STA VOLNAME,X
DEX
BNE DSNMLP
DSSCTLP LDY #0
LDA (IPTR),Y ;Check track ($FF if deleted)
BEQ DSDONE ;End of catalog
CMP #$FF
BNE DSGOOD
LDA #35 ;Skip deleted file
BNE DSDLTD
DSGOOD INC IPTR
INC IPTR
LDA (IPTR),Y ;Y is still 0
AND #$7F
BEQ DSSTTYP
DSTYPLP INY
LSR
BCC DSTYPLP
TYA
DSSTTYP STA FTYPE
LDX #17
JSR PUTOSNM ;Transfer system name
JSR PUTVNAME ;Transfer volume name
LDY #31
LDA #$A0 ;Space
TRSPLP DEY ;Skip trailing spaces
CMP (IPTR),Y
BEQ TRSPLP
STY FNMLNGTH
JSR TXFNAME ;Transfer file name
CLC
LDA FTYPE
ADC #DOSTYPES-TYPES+1
TAX
LDA #1
JSR PUTTYPE ;Transfer file type
LDA #33 ;35 bytes per file entry
DSDLTD JSR INCIPTR ;Raise input buffer pointer
CMP SCTPTR+1
BEQ DSSCTLP ;Still more in this sector
CLV ;Ask for another sector
CLC ;No error yet
RTS
DSDONE CLC
BIT SETV
RTS
;
;Set up volume name
;Enter with length in A
;
GETVNAME TAY
STA VOLNAME
GVNMLP LDA (IPTR),Y
STA VOLNAME,Y
DEY
BNE GVNMLP
RTS
;
;Transfer system name
;
PUTOSNM LDY #6
LDA #$0D ;Put <RETURN>
POSNMLP STA (DATPTR),Y ; at end
LDA OSNAMES,X ;Read system name
DEX ; out of table
DEY
BPL POSNMLP
LDA #6
JSR INCDPTR ;Raise data pointer
RTS
;
;Transfer volume name
;
PUTVNAME LDA #$0D
LDY VOLNAME ;Put <RETURN>
STA (DATPTR),Y ; at end
BEQ NULLNAME ;No name
PVNMLP LDA VOLNAME,Y
DEY
STA (DATPTR),Y
BNE PVNMLP
NULLNAME LDA VOLNAME
JSR INCDPTR ;Raise data pointer
RTS
;
;Transfer filename
;Enter with namelength in Y
;
MSB OFF
TXFNAME LDY FNMLNGTH
LDA #$0D ;Put <RETURN>
STA (DATPTR),Y ; at end
TXFNLP LDA (IPTR),Y
ORA #$80 ;to make UPCASE work
CMP #$A0 ;Space
BCS NOTCNTRL
LDA #'^' ;Substitute cntrl chars
NOTCNTRL JSR UPCASE
AND #$7F ;ProDOS keeps bit 7 clear
DEY
STA (DATPTR),Y
BNE TXFNLP
LDA FNMLNGTH
JSR INCDPTR ;Raise data pointer
RTS
;
;Transfer file type
;
PUTTYPE PHA
TAY
LDA #$0D ;Put <RETURN>
STA (DATPTR),Y ; at end
PTLP DEX
DEY
BMI PTXT
LDA TYPES,X
STA (DATPTR),Y
BNE PTLP
PTXT PLA
JSR INCDPTR ;Raise data pointer
RTS
;
;Increase DATPTR by one more than
; the value in A
;
INCDPTR SEC
ADC DATPTR
STA DATPTR
LDA DATPTR+1
ADC #0
STA DATPTR+1
RTS
;
;Increase IPTR by the value in A
; and compare IPTR to buffer limit
;
INCIPTR CLC
ADC IPTR
STA IPTR
LDA IPTR+1
ADC #0
STA IPTR+1
CMP IBUFTOP
RTS
;
;Subroutine to read given track and sector
; On entry, track in X, sector in A
; Calling routine must set up BRWUNIT and point
; BRWDATA to base of 512-byte buffer
; On exit, A will point to the
; appropriate half of the data buffer
;
RDTS TAY
TXA
LDX #0
STX BRWBLKNUM+1
ASL ;Block number
ASL ; is 8 times
ASL ; track number plus
ROL BRWBLKNUM+1 ; offset defined by
CLC ; sector number
ADC OFFSET,Y
STA BRWBLKNUM
CLC
LDA HALFTABLE,Y ;Only one half of
ADC BRWDATA+1 ; block will have
STA SECTOR ; relevant data
JSR MLI
DB RDBLK.C
DW BRW
BCC RDOK
JMP BADCALL ;Return by way of BADCALL
RDOK LDA SECTOR
RTS
;
;Prompting subroutine allows retry for I/O error
; or PATH NOT FOUND -- returns C clear for <return>
; or <space>, C set and A=0 for <esc>, C set and
; A=error for other errors
;
SRCEPRMPT LDX #>SRCEMSG
LDY #<SRCEMSG
BNE PROMPT ;Always
DESTPRMPT LDX #>DESTMSG
LDY #<DESTMSG
BNE PROMPT ;Always
READERR STA ERRCODE ;Save error code
JSR CLOSE ;Try to close files
LDA ERRCODE
CMP #6 ;Prompt if error is 6,7 or 8
BCC ERRRTN ; (Path not found
CMP #9 ; or I/O error)
BCS ERRRTN ;Return with some other error
LDX #>RDERRMSG
LDY #<RDERRMSG
BNE PROMPT ;Always
WRITERR STA ERRCODE ;Save error code
JSR CLOSE ;Try to close files
LDA ERRCODE
CMP #4 ;Write-protected
BNE WRER1
LDX #>WRPRTMSG
LDY #<WRPRTMSG
BNE PROMPT ;Always
WRER1 CMP #9 ;Disk full
BEQ WRER2
CMP #$11 ;Directory full
BNE WRER3
WRER2 LDX #>FULLMSG
LDY #<FULLMSG
BNE PROMPT ;Always
WRER3 LDX #>WRERRMSG ;Misc write error
LDY #<WRERRMSG
PROMPT LDA #10
JSR MESSAGE
PROMPT1 LDY #<ACTIONREQ
LDX #>ACTIONREQ
LDA #11
JSR MESSAGE ;Display prompt
KEY JSR RDKEY ;Wait for a keystroke
TAX ;Save keystroke
JSR CROUT
CPX #$8D ;<RETURN>
BEQ RETRY ;Clear C to try again
CPX #$A0 ;<SPACE>
BEQ RETRY ;Clear C to try again
LDA #0 ;Code for no error
CPX #$9B ;<ESC>
BEQ ERRRTN ;False error to get out
BNE PROMPT1
ERRRTN SEC ;C set means error
RTS
RETRY CLC
RTS
;
;Subroutine to print message or prompt
;
MESSAGE STX PRTPTR ;Point to
STY PRTPTR+1 ; appropriate message
JSR TABV ;Vertical tab
JSR CROUT ;Start new line
JSR CLREOP
LDY #0
LDA (PRTPTR),Y ;Get length of message
TAX ;Use X as counter
PRTLP INY ; and Y as pointer
LDA (PRTPTR),Y
BIT MACHID
BMI PRTOUT ;On Apple II, change
JSR UPCASE ; lower case to upper
PRTOUT JSR COUT ;Print a char
DEX ;Count down
BNE PRTLP ; until done
RTS
;
;Subsubroutine to convert lower case
;
MSB ON
UPCASE CMP #'a'
BCC UCRTN
CMP #'{'
BCS UCRTN
AND #$DF
UCRTN RTS
;
;Subroutine to write accumulated directories
; to file
;
OUTFILE EQU *
JSR PREFIX ;Get prefix and filename
BCS OFRTN1
;Create a TCAT file--complain if it already exists
LDA #$C3 ;Full access
STA CRACESS
LDA #4 ;Text
STA CRFILID
LDA #0
STA CRAUXID
STA CRAUXID+1
LDA #1 ;Seedling file
STA CRFKIND
LDA #CREATE.C
JSR GOSYSTEM
BCC OFOPEN
CMP #$13 ;Duplicate filename
BEQ APPNDQ ;File already exists
SEC
OFRTN1 RTS ;Real error
;Append or replace an existing TCAT file
APPNDQ LDY #<APPNDMSG ;File already exists
LDX #>APPNDMSG ; notify user and
LDA #10 ; ask whether to
JSR MESSAGE ; append or replace
LDY #<APPNDREQ
LDX #>APPNDREQ
LDA #11
JSR MESSAGE
JSR KEY ;Get answer
ROR APPNDFLG ; and save it
;Open TCAT
OFOPEN LDY #<WRITEMSG
LDX #>WRITEMSG
LDA #10
JSR MESSAGE
JSR PREFIX ;Get prefix and filename
BCS OFRTN1
LDA IBUF
STA OSYSBUF+1
LDA #0
STA OSYSBUF
LDA #OPEN.C ;Open file
JSR GOSYSTEM
BCS OFRTN2
;Set up to append, if necessary
BIT APPNDFLG ;Do we append?
BMI OFWRT
LDA OREFNUM ;Append info to end
STA SREFNUM ; of file
LDA #GETEOF.C ; by setting
JSR GOSYSTEM ; file mark
BCS OFRTN2 ; equal to
LDA #SETMARK.C ; end-of-file
JSR GOSYSTEM
BCS OFRTN2
;Write the data
OFWRT LDA OREFNUM
STA RWREFNUM
LDA #<END+$100
STA RWDATA+1 ;Beginning of
LDA #0 ; data buffer
STA RWDATA
LDA DATPTR ;Number of bytes
STA RWCOUNT ; of data in
SEC ; the buffer
LDA DATPTR+1
SBC RWDATA+1
STA RWCOUNT+1
LDA #WRITE.C
JSR GOSYSTEM ;Write it!
BCS OFRTN2
;Adjust the end-of-file mark
LDA OREFNUM
STA SREFNUM
LDA #GETMARK.C ;Set new
JSR GOSYSTEM ; end-of-file
BCS OFRTN2 ; equal to
LDA #SETEOF.C ; file mark
JSR GOSYSTEM ; in case new file
BCS OFRTN2 ; is shorter than old
;Close the file
;Warning--this is also used as an independent subroutine
CLOSE LDA OREFNUM
STA CREFNUM
LDA #CLOSE.C ;Close up
JSR GOSYSTEM
OFRTN2 RTS
;
;Subroutine to get prefix and filename
;
MSB OFF
PREFIX LDA VPATH1
STA PRTPTR
LDA VPATH1+1
STA PRTPTR+1
LDA PFIXPTR ;Is there a prefix?
BNE HAVEPFX ;Yes
LDA OFILENAME+1 ;Full pathname available?
CMP #'/'
BNE GETPFX ;No, get prefix
HAVEPFX LDY #0 ;If so, set up
LDA OFILENAME ; to transfer only filename
STA (PRTPTR),Y
TAY
TAX
BNE OFNMLP ;Always
GETPFX LDA DEFDRV ;Get volume name
ASL ; of current default
ASL ; device by getting
ORA DEFSLT ; current slot and
ASL ; drive number and
ASL ; calling OnLine to
ASL ; get volume name
ASL
STA SUNITNUM
LDX VPATH1
INX
STX SBUFADR
LDX VPATH1+1
STX SBUFADR+1
LDA #ONLINE.C
JSR GOSYSTEM
BCS PFXRTN
LDY #1
LDA (PRTPTR),Y Isolate prefix length
AND #$0F ; from first byte
ADC #$02 ;Increase name length
PHA ; to allow for initial /
LDA #'/' ; and trailing /
STA (PRTPTR),Y ;Add the first /
PLA ;Recover prefix length
TAY
LDA #'/'
STA (PRTPTR),Y ;Add trailing /
TYA
CLC ;Add filename length
ADC OFILENAME
LDY #0
STA (PRTPTR),Y ;Store pathname length
TAY
LDX OFILENAME ;Counter for filename length
OFNMLP LDA OFILENAME,X ;Add filename to end
STA (PRTPTR),Y ; of prefix
DEY
DEX
BNE OFNMLP
CLC ;No error
PFXRTN RTS
;
;Text, tables of data, and workspace
;
MSB ON
REP 32
BANNER0 ASC ' DISK LIBRARIAN PRO'
DB $8D
ASC ' by Ken Manly'
DB $8D
ASC ' Copyright (C) 1986 by MicroSPARC, Inc.'
DB $8D,$8D
BANNER1 EQU *
REP 32
;
;Parameter list for Readblock and Writeblock
;
BRW DFB 3
BRWUNIT DFB 0
BRWDATA DW 0
BRWBLKNUM DW 0
;
;Table to convert DOS sectors to ProDOS blocks
;
OFFSET DFB 0,7,6,6,5,5,4,4
DFB 3,3,2,2,1,1,0,7
;
;Table to choose right half of a block
; for a requested sector
;
HALFTABLE DFB 0,0,1,0
DFB 1,0,1,0
DFB 1,0,1,0
DFB 1,0,1,1
;
;Characteristic bytes for each type of disk
; Pascal, ProDOS, DOS master, DOS slave
; Two of each to allow for expansion
;
IDLIST DB $6,$6,$3,$3,$A9,$A9,$0,$0
;
;Codes to identify type of disk
; Pascal, ProDOS, DOS master, DOS slave
; Two of each to allow for expansion
;
IDBYTES DB $0,$0,$C0,$C0,$80,$80,$80,$80
;
;Filename for catalog listing
;
MSB OFF
OFILENAME STR 'TCAT'
DS 16-*+OFILENAME ;Extra space for filename
;
MSB ON
SRCEMSG STR 'Ready to read a disk catalog . . .'
ACTIONREQ STR 'Press <RETURN> to go, <ESC> to quit '
READMSG STR 'Reading catalog . . .'
NAMEMSG STR 'Enter a name for this DOS disk . . .'
DESTMSG STR 'Insert disk for catalog file . . .'
RDERRMSG STR 'Cannot read a disk, try again . . .'
WRPRTMSG STR 'Disk is write-protected. . .'
FULLMSG STR 'Disk full, try another. . .'
WRERRMSG STR 'Cannot write to disk, try another. . .'
APPNDMSG STR 'Catalog file already exists . . .'
APPNDREQ STR '<RETURN> to append, <ESC> to replace '
WRITEMSG STR 'Writing TCAT file . . .'
BYE STR 'Goodbye . . .'
;
MSB OFF
OSNAMES ASC 'PASCALPRODOSDOS3.3'
;
PRCODES DFB 0,1,4,6,$F,$19,$1A,$1B,$FC,$FD,$FE,$FF
TYPES ASC 'VOL BAD CODETEXTINFODATAGRAFFOTO'
PRTYPES ASC '???BADTXTBINDIRADBAWPASPBASVARRELSYS'
DOSTYPES ASC 'TIABSRAB'
;
FIRSTBLK DS 1
DISKID DS 1
IBUF DS 1
CURBLK DS 1
ERRCODE DS 1
SECTOR DS 1
IDEV DS 1
VOLNAME DS 16
FTYPE DS 1
IBUFTOP DS 1
DBUFTOP DS 1
FNMLNGTH DS 1
APPNDFLG DS 1
;
END EQU *